home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
PROGRAMM
/
BASIC
/
2905.ZIP
/
QWEZ.ZIP
/
MULTSAM1.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-06-01
|
5KB
|
94 lines
'***************************************************************************
' This is an example of using a field in MULTINPT as a FIXED CHOICE ****
' field. Field two provides the choices of BASIC, PASCAL, OR ASSEMBLY. ****
'***************************************************************************
'**** THIS PROGRAM MUST BE USED WITH ONE OF THE FOLLOWING LIBRARIES: ****
'***************************************************************************
'**** For QB4.5 unenhanced version use QBUNEN.QLB ****
'**** For BASIC 7.1 unenhanced version use PDSUNEN.QLB ****
'**** For VBDOS 1.0 unenhanced version use VBUNEN.QLB ****
'**** For QB4.50 enhanced version use QBALL.QLB or QBNER.QLB ****
'**** For BASIC 7.1 enhanced version use PDSALL.QLB or PDSNER.QLB ****
'**** For VBDOS 1.0 enhanced version use VBALL.QLB or VBNER.QLB ****
'**** Load QB, QBX, or VBDOS with the /L option and the correct library ****
'***************************************************************************
DECLARE SUB INPTINIT (DTYPE%, ISDOT%, AT1%, BLNK%, MS%)
DECLARE SUB MAKEFIELD (SCRN%, FLD%, SCODE%, STR%, SLC%, SWD%, SBASEATTR%, SACTATTR%, MATTR%, RES$, EXTO$, HOTPOS%, CURPOS%, BRACKET%)
DECLARE SUB MULTINPT (S%, TOFLD%, OPTION$, FF%, RKEY%, RTRN$(), SF%)
DECLARE SUB SETINPT (SCRN%, DISPLAYLEN%, EXIT$, HOTCOL%)
DECLARE SUB MAKEWIND (W%, LABEL$, TR%, LC%, WD%, NR%, ATTR%, BORDER%)
DECLARE SUB PRINTW (TEXT$, R%, LC%)
DECLARE SUB SETWIND (FST%, S%, SH%, NH%, BRKT%)
DECLARE FUNCTION MOUSEON% (ISON%)
'***************************************************************************
CALL SETWIND(1, 1, 7, 0, 15) ' INITIALIZE WINDOW MEMORY
CALL INPTINIT(1, 1, 1, 1, 1) ' INITIALIZE INPUT MEMORY
JUNK% = MOUSEON%(1)
COLOR 7, 0: CLS ' BLANK THE SCREEN
DIM RTRN$(5) ' For the five fields/buttons
'---------------------------------------------------------------------------
' SETINPT MUST BE CALLED FOR EACH MULTI-FIELD INPUT SCREEN
' Define each field
CALL SETINPT(1, 25, "12", 15)
FOR X% = 1 TO 3 ' define the fields
READ CODE%, TR%, LC%, WD%
CALL MAKEFIELD(1, X%, CODE%, TR%, LC%, WD%, 15, 15, 15, "", "", 0, 1, 0)
NEXT
DATA 7,5,5,30 : ' Alpha / numeric
DATA 30007,7,5,9 : ' Fixed choice - alpha / numeric
DATA 7,9,5,30 : ' Alpha / nuneric
MAKEFIELD 1, 4, 30107, 11, 13, 9, 112, 112, 15, "", "", 0, 0, 0
RTRN$(4) = "< F1=OK >"
MAKEFIELD 1, 5, 30107, 11, 56, 14, 112, 112, 15, "", "", 0, 0, 0
RTRN$(5) = "< F2= CANCEL >"
'----------------------------------------------------------------------------
TOFLD% = 1: FROMFLD% = 0 ' START IN FIELD 1. PRINT ALL
' FIELDS.
'----------------------------------------------------------------------------
' MAKE A WINDOW. PRINT INSTRUCTIONS
CALL MAKEWIND(1, "@Fixed Choice Demonstration - Second field has three choices", 1, 1, 80, 12, 112, 102)
CALL PRINTW("Any alpha/numeric input", 2, 38)
CALL PRINTW("SPACE BAR / MOUSE changes field", 4, 15)
CALL PRINTW("Any alpha/numeric input", 6, 38)
CALL PRINTW("-- Mouse selectable fields --", 8, 23)
'----------------------------------------------------------------------------
' Iinitialize data for field 2.
DIM CHOICE$(3)
CHOICE$(1) = "BASIC" ' CHOICES FOR FIXED FIELD 2.
CHOICE$(2) = "PASCAL" ' " "
CHOICE$(3) = "ASSEMBLY" ' " "
LANGCHOICE% = 1 ' MAKE IT DEFAULT TO "BASIC"
' ---------------------------------------------------------------------------
DO ' NOT F1 OR F2
RTRN$(2) = CHOICE$(LANGCHOICE%) ' RESET FIELD 2
CALL MULTINPT(1, TOFLD%, "", FROMFLD%, RKEY%, RTRN$(), SELECTION%)
'Make mouse selection on field 4 or 5 emulate the F1 or F2 keys.
IF SELECTION% <> 0 THEN RKEY% = SELECTION% - 3
IF FROMFLD% = 2 AND TOFLD% = 2 THEN ' was cursor in field 2 ?
IF RKEY% = 32 OR RKEY% = 100 THEN ' was it the SPACE BAR or MOUSE ?
LANGCHOICE% = LANGCHOICE% + 1 ' "increment" the choice.
IF LANGCHOICE% = 4 THEN LANGCHOICE% = 1
END IF
END IF
LOOP WHILE RKEY% > 2 ' Do until OK or CANCEL selection is made.
' Must be F1 or F2 or Mouse selectiing OK or CANCEL
LOCATE 15, 1
IF RKEY% = 1 THEN PRINT "OK EXITED" ELSE PRINT "CANCEL EXITED"